;;; Copyright (c) 2022 bobwxc@yeah.net
;;; This file is licensed under Mulan PSL v2.
;;; You can use this software according to the terms and conditions of
;;; the Mulan PSL v2. You may obtain a copy of Mulan PSL v2 at:
;;;     http://license.coscl.org.cn/MulanPSL2
;;; THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OF
;;; ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
;;; NON-INFRINGEMENT, MERCHANTABILITY OR FIT FOR A PARTICULAR PURPOSE.
;;; See the Mulan PSL v2 for more details.

(defpackage #:utf8-code
  (:nicknames #:u8c)
  (:documentation "UTF-8 encode and decode library.")
  (:use #:cl)
  (:export #:decode
           #:decode-to-string
           #:encode
           #:encode-from-string))

(in-package #:utf8-code)

;; 1 byte : `0xxxxxxx`
;; 2 bytes: `110xxxxx 10xxxxxx`
;; 3 bytes: `1110xxxx 10xxxxxx 10xxxxxx`
;; 4 bytes: `11110xxx 10xxxxxx 10xxxxxx 10xxxxxx`


(defun decode_ (lst)
  "Original implementation (DO NOT use it)"
  (declare (list lst))
  (cond
   ((not (car lst)) nil)
   ((<= (car lst) #b01111111) (cons (code-char (car lst))
                                    (decode_ (cdr lst))))
   ((= (logand (car lst) #b11100000) #b11000000)
    (cons (code-char (+ (ash (logand (car lst) #b00011111) 6)
                        (logand (cadr lst) #b00111111)))
          (decode_ (cddr lst))))
   ((= (logand (car lst) #b11110000) #b11100000)
    (cons (code-char (+ (ash (logand (car lst) #b00001111) 12)
                        (ash (logand (cadr lst) #b00111111) 6)
                        (logand (caddr lst) #b00111111)))
          (decode_ (cdddr lst))))
   ((= (logand (car lst) #b11111000) #b11110000)
    (cons (code-char (+ (ash (logand (car lst) #b00000111) 18)
                        (ash (logand (cadr lst) #b00111111) 12)
                        (ash (logand (caddr lst) #b00111111) 6)
                        (logand (cadddr lst) #b00111111)))
          (decode_ (cddddr lst))))
   (t (decode_ (cdr lst)))
   ))

(defun decode (lst)
  "Second implementation with stricter check (recommend)
  lst is a list of unsigned-byte 8
  return a list of character"
  (declare (list lst))
  (let ((a (car lst)))
    (declare ((or null (unsigned-byte 8)) a))
    (cond
     ((not a) nil)
     ((and (<= a #b01111111) (>= a 0))
      (cons (code-char a)
            (decode (cdr lst))))
     ((= (logand a #b11100000) #b11000000)
      (let ((b (cadr lst)))
        (if (and (= (logand b #b11000000) #b10000000))
            (cons (code-char (+ (ash (logand a #b00011111) 6)
                                (logand b #b00111111)))
                  (decode (cddr lst)))
          (progn
            (warn "UTF-8 decode failed ~X ~X ???~%" a b)
            (decode (cdr lst))))))
     ((= (logand a #b11110000) #b11100000)
      (let ((b (cadr lst))
            (c (caddr lst)))
        (if (and (= (logand b #b11000000) #b10000000)
                 (= (logand c #b11000000) #b10000000))
            (cons (code-char (+ (ash (logand a #b00001111) 12)
                                (ash (logand b #b00111111) 6)
                                (logand c #b00111111)))
                  (decode (cdddr lst)))
          (progn
            (warn "UTF-8 decode failed ~X ~X ~X ???~%" a b c)
            (decode (cdr lst))))))
     ((= (logand a #b11111000) #b11110000)
      (let ((b (cadr lst))
            (c (caddr lst))
            (d (cadddr lst)))
        (if (and (= (logand b #b11000000) #b10000000)
                 (= (logand c #b11000000) #b10000000)
                 (= (logand d #b11000000) #b10000000))
            (cons (code-char (+ (ash (logand a #b00000111) 18)
                                (ash (logand b #b00111111) 12)
                                (ash (logand c #b00111111) 6)
                                (logand d #b00111111)))
                  (decode (cddddr lst)))
          (progn
            (warn "UTF-8 decode failed ~X ~X ~X ~X ???~%" a b c d)
            (decode (cdr lst))))))
     (t
      (warn "UTF-8 decode failed ~X ???~%" a)
      (decode (cdr lst)))
     )))

(defun decode-to-string (lst)
  "lst is a list of unsigned-byte 8
  return a string
  NOTE: be careful the non-graph character when decode"
  (declare (list lst))
  (concatenate 'string (decode lst)))

(defun decode-to-string-trim (lst)
  "lst is a list of unsigned-byte 8
  return a string before the fisrt #\Nul"
  (declare (list lst))
  (let ((s (concatenate 'string (decode lst))))
    (subseq s 0 (position #\Nul s))
    ))

;; (print (concatenate 'string
;;                     (decode '(#b11100100 #b10111101 #b10100000 #b11100101
;;                               #b10100101 #b10111101 #b11101111 #b10111100
;;                               #b10001100 #b11100100 #b10111000 #b10010110
;;                               #b11100111 #b10010101 #b10001100 #b11101111
;;                               #b10111100 #b10000001))))

;; Unicode Code   UTF-8 Code
;; 0000～007F     0xxxxxxx
;; 0080～07FF     110xxxxx 10xxxxxx
;; 0800～FFFF     1110xxxx 10xxxxxx 10xxxxxx
;; 10000～10FFFF  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx

(defun encode (lst)
  "lst is a list of character
  return a list of unsigned-byte 8"
  (declare (list lst))
  (if (not (car lst)) 
      nil
    (let ((c (char-code (car lst))))
      (cond
       ((<= c #x7f) (cons c (encode (cdr lst))))
       ((<= c #x7ff) (cons (+ #b11000000 (mod (ash c -6) #b00100000))
                          (cons (+ #b10000000 (mod c #b01000000))
                                (encode (cdr lst)))))
       ((<= c #xffff) (cons (+ #b11100000 (mod (ash c -12) #b00010000))
                            (cons (+ #b10000000 (mod (ash c -6) #b01000000))
                                  (cons (+ #b10000000 (mod c #b01000000))
                                        (encode (cdr lst))))))
       ((<= c #x10ffff) (cons (+ #b11110000 (mod (ash c -18) #b00001000))
                              (cons (+ #b10000000 (mod (ash c -12) #b01000000))
                                    (cons (+ #b10000000 (mod (ash c -6) #b01000000))
                                          (cons (+ #b10000000 (mod c #b01000000))
                                                (encode (cdr lst)))))))
       (t (error "UTF-8 encode char code: ~X ???~%" c))
       ))))

(defun encode-from-string (s)
  "s is a string
  return a list of unsigned-byte 8"
  (declare (string s))
  (encode (concatenate 'list s)))

;; (print (encode-from-string "你好，世界！"))
;; (print (decode-to-string (encode '(#\a #\b #\人))))


